;(in-package :closer-common-lisp-user)

(defgeneric update-instance-after-reading (object)
  (:method ((object t)) object))

(defclass value-object () ())

(defun value-object (class-name &rest initargs)
  (declare (dynamic-extent initargs))
  (let ((object (allocate-instance (find-class class-name))))
    (loop for (slot-name value) on initargs by #'cddr do
          (setf (slot-value object slot-name) value))
    (update-instance-after-reading object)))

(defun print-value-object (object stream)
  (let ((*print-circle* nil))
    (format stream "#.(~S '~S" 'value-object (class-name (class-of object)))
    (loop for slot in (class-slots (class-of object))
          unless (eq (slot-definition-allocation slot) :class) do
          (format stream " '~S '~S"
                  (slot-definition-name slot)
                  (slot-value object (slot-definition-name slot))))
    (format stream ")")))

(defmethod print-object ((object value-object) stream)
  (if *print-readably*
    (print-value-object object stream)
    (call-next-method)))

(defclass funcallable-value-object ()
  ((definition :initarg :definition :reader funcallable-instance-definition))
  (:metaclass funcallable-standard-class))

(defmethod initialize-instance :after
  ((object funcallable-value-object) &key definition)
  (closer-common-lisp-user::set-funcallable-instance-function object (compile nil definition)))

(defmethod reinitialize-instance :after
  ((object funcallable-value-object) &key (definition nil definitionp))
  (when definitionp
    (closer-common-lisp-user::set-funcallable-instance-function object (compile nil definition))))

(defmethod update-instance-after-reading :after ((object funcallable-value-object))
  (closer-common-lisp-user::set-funcallable-instance-function object (compile nil (funcallable-instance-definition object))))

(defmethod print-object ((object funcallable-value-object) stream)
  (if *print-readably*
    (print-value-object object stream)
    (call-next-method)))

(defmacro vlambda ((&rest lambda-list) &body body)
  `(make-instance 'funcallable-value-object
                  :definition '(lambda ,lambda-list ,@body)))

(defmacro define-vfunction (name (&rest lambda-list) &body body)
  `(progn
     (declaim (notinline ,name))
     (defun ,name ,lambda-list)
     (setf (fdefinition ',name)
           (vlambda ,lambda-list ,@body))
     ',name))
